home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1988-02-13 | 1.9 KB | 73 lines |
- IMPLEMENTATION MODULE Disk;
-
-
- FROM SYSTEM IMPORT ADDRESS, ADR;
- IMPORT GEMDOS;
- IMPORT AESForms;
- IMPORT Text;
-
-
- CONST
-
- FullErrorLine1 = "[3][ The disk is full. Please | delete any unnecessary files |";
- FullErrorLine2 = " before trying this operation. ][ OK ]";
-
- (********************************************************************)
-
- PROCEDURE CheckStatus ( Drive : (* IN *) CARDINAL );
-
- TYPE DTA = RECORD
- Reserved : ARRAY [0..20] OF CHAR;
- Attributes : CHAR;
- Time : CARDINAL;
- Date : CARDINAL;
- Size : LONGCARD;
- Name : ARRAY [0..13] OF CHAR;
- END;
-
- VAR
- DriveMap : LONGCARD;
- SavedDTA : ADDRESS;
- DTABuffer : DTA;
- Result : INTEGER;
-
- BEGIN
- GEMDOS.SetDrv ( Drive - 1, DriveMap );
- GEMDOS.GetDTA ( SavedDTA );
- GEMDOS.SetDTA ( ADR (DTABuffer) );
- GEMDOS.SFirst ( "*.*", 010H, Result );
- GEMDOS.SetDTA ( SavedDTA );
- END CheckStatus;
-
- (********************************************************************)
-
- PROCEDURE SpaceAvailable (
- Drive : (* IN *) CARDINAL;
- BytesNeeded : (* IN *) LONGCARD ) : BOOLEAN;
-
- VAR
- InfoBuffer : GEMDOS.DiskInfoBuffer;
- FreeBytes : LONGCARD;
- Success : BOOLEAN;
- FullError : ARRAY [0..150] OF CHAR;
- Choice : INTEGER;
-
- BEGIN
- GEMDOS.DFree ( InfoBuffer, Drive );
- WITH InfoBuffer DO
- FreeBytes := freeSpace * clusterSize * sectorSize;
- END;
- IF FreeBytes < BytesNeeded THEN
- FullError := FullErrorLine1;
- Success := Text.ConcatString ( FullError, FullErrorLine2, FullError );
- Choice := AESForms.FormAlert ( 1, FullError );
- RETURN (FALSE);
- ELSE
- RETURN (TRUE);
- END;
- END SpaceAvailable;
-
-
- END Disk.
-
-